{ This unit maintains a database of peer addresses. On application start
  it will try to get a bunch of new addresses from the DNS seeds so there
  is at least a minimum of addresses in the db and after connection it will
  receive more addreses from the addr messages that we receive. }
unit bitcoin_peerfinder;
{$mode objfpc}{$H+}

interface
type
  TStrAddrAndPort = record
    StrAddr: String;
    Port: Word;
  end;


function GetAnotherPeerAddress4: TStrAddrAndPort;
procedure RemoveAddress4FromDb(StrAddr4: String);
procedure AddAddress4ToDb(StrAddr4: String; Port: Word);

implementation
uses
  {$IFDEF WINDOWS} WinSock2,{$ENDIF}
  Classes, SysUtils, base64, Sockets, db, dbf, logging;

const
  MAX_ADDRESSES = 2000; // how many addresses to keep on disk.

  {$IFDEF TESTNET}
  {$ELSE}
  DnsSeedDomains : array[0..2] of String = (
    'bitseed.xf2.org',
    'bitseed.bitcoin.org.uk',
    'dnsseed.bluematt.me'
  );
  {$ENDIF}

  {$IFDEF UNIX} // we need gethostbyname() from libc
  LIB_C_NAME = 'c';
  {$ENDIF}


type
  {$IFDEF UNIX}
  { On Windows we have *ALMOST* the same already through Winsock2,
    elsewhere we need this record for a call to libc gethostbyname()
    Its only almost the same because in windows some of the integers
    are smallint, however, the names and the meanings are eactly the
    same, so it will compile and run.}
  PHostEnt = ^THostEnt;
  THostEnt = record
    h_name: PChar;              // official name of host
    h_aliases: ^PChar;          // alias list
    h_addrtype: Integer;        // host address type
    h_length: Integer;          // length of address
    case Byte of
      0: (h_addr_list: ^PChar); // points to a list of pointers to addresses
      1: (h_addr: ^PChar)       // I don't know why they defined it as ^PChar
  end;                          // in the windows unit, now I have to define
                                // it as ^Pchar for the libc version too to
                                // be able to use the same code for both.
  {$ENDIF}
  ppin_addr = ^pin_addr;        // pointer to a list of pointers to addresses

  { all in_addr variables in this entire unit are without exception
  strictly in network byte order (big endian) to remove all confusion. }

  TAddrList4 = array of in_addr; // addresses in NET byte order (big endian)

  { TTimer }

  TTimer = class(TThread)
    procedure Execute; override;
  end;

var
  Table    : TDbf;
  Timer    : TTimer;
  Critical : TRTLCriticalSection;

{$IFDEF UNIX} { On Windows we have this already through Winsock2 }
function  gethostbyname(name: PChar): PHostEnt; cdecl; external LIB_C_NAME name 'gethostbyname';
{$ENDIF}

function NetAddr4ToBase64(NetAddr4: in_addr): String;
var
  S        : String;
begin
  SetLength(S, 16); // this string represents a binary big endian in6_addr
  FillByte({%H-}S[1], 10, $00);
  FillByte(S[11], 2, $ff);
  Move(NetAddr4, S[13], 4);
  Result := EncodeStringBase64(S);
end;

function Base64ToNetAddr4(Base64Addr: String): in_addr;
var
  S        : String;
begin
  S := DecodeStringBase64(Base64Addr);
  Move(S[13], Result, 4); // only last 4 bytes, ignore the everything else.
end;

function GetSeedAddressesFromDns(ADomainName: String): TAddrList4;
var
  Answer   : PHostEnt;
  I        : Integer;
  List     : ppin_addr;
begin
  log('querying IP adresses from %s', [ADomainName]);
  Answer := gethostbyname(PChar(ADomainName));
  if Answer = nil then
    exit;
  if Answer^.h_addrtype <> AF_INET then
    exit;
  List := ppin_addr(Answer^.h_addr_list);
  I := 0;
  while List^ <> nil do begin
    SetLength(Result, I+1);
    Result[I] := List^^;
    Inc(List);
    Inc(I);
  end;
end;


{ combine two address lists }
function CombineList(A, B: TAddrList4): TAddrList4;
var
  I : Integer;
  J : Integer;
begin
  SetLength(Result, Length(A) + Length(B));
  for I := 0 to Length(A)-1 do begin
    Result[I] := A[I];
  end;
  J := Length(A);
  for I := 0 to Length(B)-1 do begin
    Result[J] := B[I];
    Inc(J);
  end;
end;


function GetSeedAddresses: TAddrList4;
var
  DomainName: String;
begin
  {$IFDEF TESTNET}
  SetLength(Result, 1);
  Result[0] := StrToNetAddr('127.0.0.1');
  {$ELSE}
  for DomainName in DnsSeedDomains do begin
    Result := CombineList(Result{%H-}, GetSeedAddressesFromDns(DomainName));
  end;
  {$ENDIF}
end;

procedure TryAddAddress(NetAddr4: in_addr; Port: Word);
var
  Base64Addr : String;
begin
  // Locate() will use the index if it exists.
  Base64Addr := NetAddr4ToBase64(NetAddr4);
  try
    EnterCriticalsection(Critical);
    if not Table.Locate('Address', Base64Addr, []) then begin
      if Table.ExactRecordCount >= MAX_ADDRESSES then begin
        Table.First; // oldest timestamp (we have LastSeen as current index)
        Table.Edit;
        Log('replacing oldest address with %s:%d (%d records)',
          [NetAddrToStr(NetAddr4), Port, Table.ExactRecordCount]);
      end else begin
        Table.Append;
        Log('adding address %s:%d to database (%d records)',
          [NetAddrToStr(NetAddr4), Port, Table.ExactRecordCount+1]);
      end;
      Table.FieldByName('Address').AsString := Base64Addr;
      Table.FieldByName('Port').AsInteger := Port;
    end else begin
      Table.Edit;
      Log('updating time stamp for %s:%d (knew this address already)', [NetAddrToStr(NetAddr4), Port]);
    end;
    Table.FieldByName('LastSeen').AsFloat := Now;
  finally
    try
      Table.Post;
    finally
      LeaveCriticalsection(Critical);
    end;
  end;
end;

procedure SeedAddressesIntoDb;
var
  Seed: TAddrList4;
  Addr  : in_addr;
begin
  Seed := GetSeedAddresses;
  for Addr in Seed do begin
    TryAddAddress(Addr, 8333); {$note port always 8333 when seeding from DNS}
  end;
  log('There are %d peer addresses in the database', [Table.ExactRecordCount]);
end;

procedure OpenDb;
begin
  Table := TDbf.Create(nil);
  with Table do begin
    Exclusive := True;
    TableName := 'addr.dbf';
    TableLevel := 3;
    log('opening %s', [TableName]);
    try
      Open;
    except
      with FieldDefs do begin
        Clear;
        Add('Address',ftString, 24); // Base64(in6_addr in big endian)
        Add('Port',ftInteger);       // Port number in host byte order
        Add('LastSeen',ftFloat);     // Pascal TDateTime
      end;
      CreateTable;
      Open;
      AddIndex('Address', 'Address', [ixUnique]);
      AddIndex('Lastseen', 'LastSeen', []);
    end;
    IndexName := 'LastSeen';
    log('packing %s', [TableName]);
    PackTable;
    log('indexing %s', [TableName]);
    RegenerateIndexes;
    log('seeding %s from DNS', [TableName]);
    SeedAddressesIntoDb;
  end;
  Timer := TTimer.Create(True);
  Timer.Start;
end;

procedure CloseDb;
begin
  log('closing %s', [Table.TableName]);
  Table.Close;
  Table.Free;
end;

function GetAnotherPeerAddress4: TStrAddrAndPort;
var
  Base64Addr : String;
begin
  try
    EnterCriticalsection(Critical);
    Table.Last;
    Base64Addr := Table.FieldByName('Address').AsString;
    Result.StrAddr := NetAddrToStr(Base64ToNetAddr4(Base64Addr));
    Result.Port := Table.FieldByName('Port').AsInteger;
    Table.Delete;
    if Table.ExactRecordCount < 10 then begin
      log('running out of addresses soon, trying to seed again');
      SeedAddressesIntoDb;
    end;
  finally
    LeaveCriticalsection(Critical);
  end;
end;

procedure RemoveAddress4FromDb(StrAddr4: String);
var
  Base64Addr : String;
begin
  Base64Addr := NetAddr4ToBase64(StrToNetAddr(StrAddr4));
  try
    EnterCriticalsection(Critical);
    if Table.Locate('Address', Base64Addr, []) then begin
      Table.Delete;
    end;
  finally
    LeaveCriticalsection(Critical);
  end;
end;

procedure AddAddress4ToDb(StrAddr4: String; Port: Word);
begin
  TryAddAddress(StrToNetAddr(StrAddr4), Port);
end;

{ TTimer }

procedure TTimer.Execute;
var
  RTot, RUse: Integer;
  T0, T1 : TDateTime;
begin
  repeat
    Sleep(1000*60);
    try
      EnterCriticalsection(Critical);
      Table.ShowDeleted := True;
      RTot := Table.ExactRecordCount;
      Table.ShowDeleted := False;
      RUse := Table.ExactRecordCount;
      log('*** address database: used records: %d, deleted records: %d', [RUse, RTot-RUse]);
      log('*** packing table and indexes');
      T0 := Now;
      Table.PackTable;
      T1 := Now;
      log('*** packing done in %d ms', [round((T1-T0)*24*60*60*1000)]);
    finally
      LeaveCriticalsection(Critical);
    end;
  until Terminated;
end;

initialization
  InitCriticalSection(Critical);
  OpenDb;
finalization
  CloseDb;
  DoneCriticalSection(Critical);
end.

